home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / pcl4p341.zip / TERM.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-01  |  10KB  |  296 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*      TERM.PAS          May 1992           *)
  4. (*                                           *)
  5. (*  TERM is a simple terminal emulator which *)
  6. (*  features XMODEM, YMODEM, and YMODEM-G    *)
  7. (*  file transfer                            *)
  8. (*                                           *)
  9. (*  Do NOT select YMODEM-G when using a null *)
  10. (*  modem cable unless you are certain that  *)
  11. (*  RTS & CTS are reversed -- which is       *)
  12. (*  usually not true.                         *)
  13. (*                                           *)
  14. (*  This program is donated to the Public    *)
  15. (*  Domain by MarshallSoft Computing, Inc.   *)
  16. (*  It is provided as an example of the use  *)
  17. (*  of the Personal Communications Library.  *)
  18. (*                                           *)
  19. (*********************************************)
  20.  
  21. {$I DEFINES.PAS}
  22.  
  23. program term;
  24. uses term_io, modem_io, xymodem, xypacket, crc, crt, PCL4P;
  25.  
  26. Var
  27.   ResetFlag : Boolean;
  28.   Port : Integer;
  29.   SioBuffer : array[0..2047] of Byte;
  30.  
  31. function MatchBaud(BaudRate : LongInt) : Integer;
  32. Label 999;
  33. const
  34.    BaudRateArray : array[1..10] of LongInt =
  35.        (300,600,1200,2400,4800,9600,19200,38400,57600,115200);
  36. var
  37.    i : Integer;
  38. begin
  39.    for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
  40.       begin
  41.         MatchBaud := i - 1;
  42.         goto 999
  43.       end;
  44.    (* no match *)
  45.    MatchBaud := -1;
  46. 999: end;
  47.  
  48. procedure MyHalt( Code : Integer );
  49. var
  50.    RetCode : Integer;
  51. begin
  52.    if Code < 0 then SayError( Code,'Halting' );
  53.    if ResetFlag then RetCode := SioDone(Port);
  54.    writeln('*** HALTING ***');
  55.    Halt;
  56. end;
  57.  
  58. (* main program *)
  59.  
  60. label 500;
  61.  
  62. const
  63.   NAK = $15;
  64.   WrongBaud1 = 'Cannot recognize baud rate';
  65.   WrongBaud2 = 'Must be 300,600,1200,2400,4800,9600,19200,38400,57600, or 155200';
  66.  
  67. var
  68.   Filename : String20;
  69.   c : Char;
  70.   BaudRate : LongInt;
  71.   BaudCode : Integer;
  72.   Protocol : Char;
  73.   Buffer  : BufferType;
  74.   RetCode : Integer;
  75.   TheByte : Char;
  76.   i       : Integer;
  77.   MenuMsg : String40;
  78.   StatusMsg : String40;
  79.   ResultMsg : String20;
  80.   GetNameMsg: String40;
  81.   OneKflag : Boolean;
  82.   NCGbyte  : Byte;
  83.   BatchFlag: Boolean;
  84.   Flag : Boolean;
  85.   Version : Integer;
  86. begin   (* main program *)
  87.   InitCRC;
  88.   TextMode(BW80);
  89.   ClrScr;
  90.   Window(1,1,80,24);
  91.   ResetFlag := FALSE;
  92.   Protocol := 'X';
  93.   OneKflag := FALSE;
  94.   NCGbyte := NAK;
  95.   BatchFlag := FALSE;
  96.   MenuMsg := 'Q)uit P)rotocol S)end R)eceive: ';
  97.   GetNameMsg := 'Enter filename: ';
  98.   StatusMsg := 'COM? X  "ESC for menu" ';
  99.   (* fetch PORT # from command line *)
  100.   if ParamCount <> 2 then
  101.     begin
  102.       writeln('USAGE: "TERM <port> <buadrate>" ');
  103.       halt;
  104.     end;
  105.   Val( ParamStr(1),Port, RetCode );
  106.   if RetCode <> 0 then
  107.     begin
  108.       writeln('Port must be 1 to 4');
  109.       Halt;
  110.     end;
  111.   (* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
  112.   Port := Port - 1;
  113.   Val( ParamStr(2),BaudRate, RetCode );
  114.   if RetCode <> 0 then
  115.     begin
  116.       writeln(WrongBaud1);
  117.       writeln(WrongBaud2);
  118.       Halt;
  119.     end;
  120.   BaudCode := MatchBaud(BaudRate);
  121.   if BaudCode < 0 then
  122.     begin
  123.       writeln(WrongBaud1);
  124.       writeln(WrongBaud2);
  125.       halt;
  126.     end;
  127.   (* patch up status message *)
  128.   StatusMsg[4] := chr($31+Port);
  129.   Insert(ParamStr(2),StatusMsg,8);
  130.   WriteMsg(StatusMsg,40);
  131.   if (Port<COM1) or (Port>COM4) then
  132.     begin
  133.       writeln('Port must be 1 to 4');
  134.       Halt
  135.     end;
  136.   (****** custom configuration ******
  137.       RetCode := SioIRQ(COM3,IRQ2,ThirdISR);
  138.       RetCode := SioIRQ(COM4,IRQ5,FourthISR);
  139.   ***********************************)
  140.   (* setup 2K receive buffer *)
  141.   RetCode := SioRxBuf(Port, Ofs(SioBuffer), Seg(SioBuffer), Size2K);
  142.   if RetCode < 0 then MyHalt( RetCode );
  143.   (* reset port *)
  144.   RetCode := SioReset(Port,BaudCode);
  145.   (* if error then try one more time *)
  146.   if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  147.   (* Was port reset ? *)
  148.   if RetCode <> 0 then
  149.     begin
  150.       writeln('Cannot reset COM',Port+1);
  151.       MyHalt( RetCode );
  152.     end;
  153.   (* Port successfully reset *)
  154.   ResetFlag := TRUE;
  155.   ClrScr;
  156.   (* show logon message *)
  157.   WriteLn('TERM 5/1/92');
  158.   Version := SioInfo('V');
  159.   WriteLn('Library Version ',Version div 16,'.',Version mod 16);
  160.   (* specify parity, # stop bits, and word length for port *)
  161.   RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  162.   if RetCode < 0 then MyHalt( RetCode );
  163.   RetCode := SioRxFlush(Port);
  164.   if RetCode < 0 then MyHalt( RetCode );
  165.   (* set FIFO level if have INS16550 *)
  166.   RetCode := SioFIFO(Port, LEVEL_8);
  167.   if RetCode > 0 then writeln('INS16550 detected');
  168.   (* set DTR & RTS *)
  169.   RetCode := SioDTR(Port,SetPort);
  170.   RetCode := SioRTS(Port,SetPort);
  171. {$IFDEF RTS_CTS_CONTROL}
  172.   (* enable RTS/CTS flow control *)
  173.   RetCode := SioFlow(Port,3*18);
  174.   WriteLn('Hardware flow control enabled');
  175.   Write('CTS = ');
  176.   if SioCTS(Port) > 0 then WriteLn('ON') else WriteLn('OFF');
  177. {$ENDIF}
  178.  
  179. {$IFDEF AT_COMMAND_SET}
  180.   (* send initialization string to modem *)
  181.   SendTo(Port,'!AT!!~');
  182.   SendTo(Port,'!AT E1 S7=60 S11=60 V1 X1 Q0 S0=1!');
  183.   if WaitFor(Port,'OK') then writeln('MODEM ready')
  184.   else writeln('WARNING: Expected OK not received');
  185. {$ENDIF}
  186.  
  187.   (* begin terminal loop *)
  188.   WriteMsg(StatusMsg,40);
  189.   LowVideo;
  190.   while TRUE do
  191.     begin (* while TRUE *)
  192.       (* did user press Ctrl-BREAK ? *)
  193.       if SioBrkKey then
  194.         begin
  195.           writeln('User typed Ctl-BREAK');
  196.           RetCode := SioDone(Port);
  197.           Halt;
  198.         end;
  199.       (* anything incoming over serial port ? *)
  200.       RetCode := SioGetc(Port,0);
  201.       if RetCode < -1 then MyHalt( RetCode );
  202.       if RetCode > -1 then write(chr(RetCode));
  203.       (* has user pressed keyboard ? *)
  204.       if KeyPressed then
  205.         begin (* keypressed *)
  206.           (* read keyboard *)
  207.           TheByte := ReadKey;
  208.           (* quit if user types ESC *)
  209.           if TheByte = chr($1b) then
  210.             begin (* ESC *)
  211.               WriteMsg(MenuMsg,1);
  212.               ReadMsg(ResultMsg,32,1);
  213.               c := UpCase(ResultMsg[1]);
  214.               case c of
  215.                 'Q':  (* QUIT *)
  216.                    begin
  217.                      WriteLn;
  218.                      WriteLn('TERMINATING: User pressed <ESC>');
  219.                      RetCode := SioDone(Port);
  220.                      Halt;
  221.                    end;
  222.                 'P':  (* PROTOCOL *)
  223.                    begin
  224.                      WriteMsg('X) xmodem, Y) ymodem, G) ymodem-g:  ',1);
  225.                      ReadMsg(ResultMsg,35,1);
  226.                      c := UpCase(ResultMsg[1]);
  227.                      case c of
  228.                        'X': (* XMODEM *)
  229.                           begin
  230.                             Protocol := 'X';
  231.                             OneKflag := FALSE;
  232.                             NCGbyte := NAK;
  233.                             BatchFlag := FALSE;
  234.                             WriteMsg('Protocol = XMODEM',1);
  235.                           end;
  236.                        'Y': (* YMODEM *)
  237.                           begin
  238.                             Protocol := 'Y';
  239.                             OneKflag := TRUE;
  240.                             NCGbyte := Ord('C');
  241.                             BatchFlag := TRUE;
  242.                             WriteMsg('Protocol = YMODEM',1);
  243.                           end;
  244.                        'G': (* YMODEM-G *)
  245.                           begin
  246.                             Protocol := 'G';
  247.                             OneKflag := TRUE;
  248.                             NCGbyte := Ord('G');
  249.                             BatchFlag := TRUE;
  250.                             WriteMsg('Protocol = YMODEM-G',1);
  251.                           end;
  252.                      end; (* case *)
  253.                      StatusMsg[6] := Protocol;
  254.                      WriteMsg(StatusMsg,40)
  255.                    end;
  256.                 'S': (* Send *)
  257.                    begin
  258.                      WriteMsg(GetNameMsg,1);
  259.                      ReadMsg(Filename,16,20);
  260.                      if Length(FileName) = 0 then goto 500;
  261.                      Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  262.                      if BatchFlag then
  263.                        begin
  264.                          (* send empty filename *)
  265.                          Filename := '';
  266.                          RetCode := SioDelay(5);
  267.                          Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  268.                        end
  269.                      end; (* Send *)
  270.                   'R': (* Receive *)
  271.                      begin
  272.                        if BatchFlag then
  273.                          repeat
  274.                            WriteMsg('Ready for next file',1);
  275.                            Filename := '';
  276.                            Flag := RxyModem(Port,Filename,Buffer,NCGbyte,BatchFlag);
  277.                          until KeyPressed or (Length(Filename) = 0)
  278.                        else
  279.                          begin (* not BatchFlag *)
  280.                            WriteMsg(GetNameMsg,1);
  281.                            ReadMsg(Filename,16,20);
  282.                            If Length(Filename) = 0 then exit;
  283.                            Flag := RxyModem(Port,Filename,Buffer,NCGbyte,BatchFlag);
  284.                          end
  285.                      end (* Receive *)
  286.                    else WriteMsg('Bad response',1);
  287.                    end; (* case *)
  288.                    500:
  289.                 end; (* ESC *)
  290.               (* send out over serial line *)
  291.               RetCode := SioPutc(Port, TheByte );
  292.               if RetCode < 0 then MyHalt( RetCode );
  293.             end (* keypressed *)
  294.       end (* while TRUE *)
  295. end.
  296.